home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr09 / readpaf.zip / READPAF.PAS < prev   
Pascal/Delphi Source File  |  1993-06-16  |  9KB  |  326 lines
  1. {$R-}    {Range checking off}
  2. {$B+}    {Boolean complete evaluation on}
  3. {$S+}    {Stack checking on}
  4. {$N-}    {No numeric coprocessor}
  5. {$M 65500,16384,655360} {Turbo 3 default stack and heap}
  6.  
  7. {$I-}
  8. PROGRAM readpaf;
  9.  
  10. {This program is an abbreviated version of my program FR2SDF.  This program
  11. is intended to demonstrate how to use Turbo Pascal to read PAF files.  It is
  12. strongly recommended that you send $5.00 to:
  13.  
  14.     The Church of Jesus Christ of Latter-Day Saints
  15.     Family History Department
  16.     50 East North temple Street
  17.     Salt Lake City, Utah 84150
  18.  
  19. and ask for "Personal Ancestral File Family Records Data Structure
  20. Description".  This document describes gives full technical details on the
  21. data structures used in PAF.  This information will be needed to expand
  22. this program to read all the data in all the PAF files.
  23.  
  24. This program will only read the INDIV2 and NAME2 files of PAF.  It will
  25. write a file with the person's RIN number, all four name fields, the sex
  26. field, older sibling RIN, own marriage MRIN, and parent's marriage MRIN.
  27. It does not convert the dates, (which is a real experience!) or the
  28. rest of the data in the INDIV2, MARR2, and NOTE2 files.  This is left, as
  29. they say, as an exercise for the reader.
  30.  
  31. This program requires at least version 4.0 of Turbo Pascal.  It should
  32. work with later versions, but has only been tested with version 4.0.}
  33.  
  34. Uses
  35.   Crt;
  36.  
  37. type
  38.   Short_Date = Array[1..3] of Byte;
  39.   Long_Date  = Array[1..4] of Byte;
  40.   String4  = String[4];
  41.   String5  = String[5];
  42.   String16 = String[16];
  43.   String20 = String[20];
  44.  
  45.   Name2 = record
  46.             Left_Link  : Word;
  47.             Name       : Array[1..17] of Char;
  48.             Right_Link : Word;
  49.               end;
  50.  
  51.   Indiv2 = record
  52.             SurName             : Word;
  53.             Given_1_Name        : Word;
  54.             Given_2_Name        : Word;
  55.             Given_3_Name        : Word;
  56.             Title               : Word;
  57.             Sex                 : Char;
  58.             Birth_Date          : Long_Date;
  59.             Birth_Place_1       : Word;
  60.             Birth_Place_2       : Word;
  61.             Birth_Place_3       : Word;
  62.             Birth_Place_4       : Word;
  63.             Christening_Date    : Long_Date;
  64.             Christening_Place_1 : Word;
  65.             Christening_Place_2 : Word;
  66.             Christening_Place_3 : Word;
  67.             Christening_Place_4 : Word;
  68.             Death_Date          : Long_Date;
  69.             Death_Place_1       : Word;
  70.             Death_Place_2       : Word;
  71.             Death_Place_3       : Word;
  72.             Death_Place_4       : Word;
  73.             Burial_Date         : Long_Date;
  74.             Burial_Place_1      : Word;
  75.             Burial_Place_2      : Word;
  76.             Burial_Place_3      : Word;
  77.             Burial_Place_4      : Word;
  78.             Baptism_Date        : Short_Date;
  79.             Baptism_Temple      : Word;
  80.             Endowment_Date      : Short_Date;
  81.             Endowment_Temple    : Word;
  82.             Sealing_Date        : Short_Date;
  83.             Sealing_Temple      : Word;
  84.             Older_Sibling       : Word;
  85.             Own_Marriage        : Word;
  86.             Parent_Marriage     : Word;
  87.             ID_Number           : Array[1..10] of Char;
  88.             Note_Pad            : Word;
  89.               end;
  90.  
  91.  
  92. VAR
  93.  
  94.   Name2File      : file of Name2;
  95.   Indiv2File     : file of Indiv2;
  96.   ThisName2      : Name2;
  97.   ThisIndiv2     : Indiv2;
  98.   Indiv2Txt      : Text;
  99.  
  100.   Command_Line_Path  : String[127];
  101.   FileName           : String[127];
  102.  
  103. const
  104.   IOVal                : Integer = 0;
  105.   IOErr                : Boolean = False;
  106.   Use_Name_File        : Boolean = True;
  107.  
  108.  
  109.  
  110. {
  111.        The routine IOCheck, along with the global declarations
  112.        IOFlag and IOErr, should be placed in any program where you
  113.        want to handle your own I/O error checking.
  114. }
  115.  
  116. procedure IOCheck;
  117. {
  118.        This routine sets IOErr equal to IOresult, then sets
  119.        IOFlag accordingly.  It also prints out a message on
  120.        the 24th line of the screen, then waits for the user
  121.        to hit any character before proceding.
  122. }
  123. var
  124.   Ch                   : Char;
  125. begin
  126.   IOVal := IOresult;
  127.   IOErr := (IOVal <> 0);
  128.   if IOErr then begin
  129.     {GotoXY(1,24);} ClrEol;        { Clear error line }
  130.     Write(Chr(7));
  131.     case IOVal of
  132.       $02  :  Write('File not found ', FileName);
  133.       $03  :  Write('Path not found ', Command_Line_Path);
  134.       $04  :  Write('File not open');
  135.       $10  :  Write('Error in numeric format');
  136.       $20  :  Write('Operation not allowed on a logical device');
  137.       $21  :  Write('Not allowed in direct mode');
  138.       $22  :  Write('Assign to standard files not allowed');
  139.       $90  :  Write('Record length mismatch');
  140.       $91  :  Write('Seek beyond end of file');
  141.       $99  :  Write('Unexpected end of file');
  142.       $F0  :  Write('Disk write error');
  143.       $F1  :  Write('Directory is full');
  144.       $F2  :  Write('File size overflow');
  145.       $FF  :  Write('File disappeared')
  146.     else      Write('Unknown I/O error:  ',IOVal:3)
  147.     end;
  148.     {Read(Kbd,Ch)} HALT
  149.   end
  150. end; { of proc IOCheck }
  151.  
  152. {procedure dirlist;
  153. begin
  154. end; }
  155.  
  156. function Get_Name (Name_Pointer : Word) : String16;
  157.  
  158. { This function will take a name pointer value, look it up in the
  159.   Name File, and return the value. If the name pointer value is
  160.   zero (null), then a blank name is returned.}
  161.  
  162. Var
  163.   Counter        : Integer;
  164.   Name_From_File : Array[1..16] of Char;
  165.  
  166. Const
  167.   Space16        : String16 = '                ';
  168.  
  169. Begin
  170.  
  171.  
  172.   If Name_Pointer <> 0 Then
  173.   Begin
  174.     Seek(Name2File, Name_Pointer);
  175.     IOCheck;
  176.     Read(Name2File, ThisName2);
  177.     IOCheck;
  178.     With ThisName2 Do Begin
  179.       Counter := 1;
  180.       While Name[Counter] <> #00 Do Begin
  181.         Name_From_File[Counter] := Name[Counter];
  182.         Inc(Counter);
  183.       end;
  184.     end;
  185.     While Counter < 17 Do Begin
  186.       Name_From_File[Counter] := ' ';
  187.       Inc(Counter);
  188.     end;
  189.     Get_Name := Name_From_File;
  190.   end
  191.   else
  192.     Get_Name := Space16;
  193. end; {function Get_Name}
  194.  
  195.  
  196. function Convert_To_String ( Rin : Word) : String5;
  197.  
  198. {takes an integer and converts it to a 5 byte ASCII string}
  199.  
  200. Var
  201.   Temp_String : String5;
  202.  
  203. Begin
  204.  
  205.   Str(Rin:5, Temp_String);
  206.   Convert_To_String := Temp_String;
  207.  
  208. end; {function Convert_To_String}
  209.  
  210. procedure Write_Indiv_File
  211.   (Var r1 : String5;
  212.        sn : String16;
  213.        n1 : String16;
  214.        n2 : String16;
  215.        n3 : String16;
  216.        sx : Char;
  217.        os : String5;
  218.        om : String5;
  219.        pm : String5);
  220.  
  221. Begin
  222.  
  223.   If sx = #00 Then sx := ' ';
  224.  
  225.   WriteLn(Indiv2Txt, r1, sn, n1, n2, n3, sx, os, om, pm);
  226.   IOCheck;
  227.  
  228. end; {procedure Write_Indiv_File}
  229.  
  230.  
  231.  
  232. procedure Convert_Indiv2;
  233.  
  234. Var
  235.   rec_no  : String5;
  236.   Counter : Integer;
  237.  
  238. Const
  239.   Event_Bir  : String4 = 'BIR ';
  240.   Event_Chr  : String4 = 'CHR ';
  241.   Event_Dea  : String4 = 'DEA ';
  242.   Event_Bur  : String4 = 'BUR ';
  243.  
  244. begin
  245.   {Determine which record we have}
  246.   Str((FilePos(Indiv2File) - 1):5, rec_no);
  247.  
  248.   GotoXY(1,9);  {Display record being processed on the screen}
  249.   WriteLn('Individual Record being converted: ', rec_no);
  250.  
  251.   With ThisIndiv2 Do    {Get the values from the record}
  252.   Begin
  253.  
  254.     Write_Indiv_File      {Write the Indiv2 File}
  255.     (rec_no,
  256.     Get_Name(SurName),
  257.     Get_Name(Given_1_Name),
  258.     Get_Name(Given_2_Name),
  259.     Get_Name(Given_3_Name),
  260.     Sex,
  261.     Convert_To_String(Older_Sibling),
  262.     Convert_To_String(Own_Marriage),
  263.     Convert_To_String(Parent_Marriage));
  264.   end;
  265.  
  266. end;  {procedure Convert_Indiv2}
  267.  
  268. procedure Open_Files;
  269.  
  270. Begin
  271.   If ParamCount > 0 Then              {This pulls the path from the}
  272.     Command_Line_Path := ParamStr(1)  {command line if it is entered.}
  273.   else
  274.     Command_Line_Path := '';
  275.   FileName := Concat(Command_Line_Path, 'NAME2.DAT');
  276.   Assign(Name2File,FileName);
  277.   Reset(Name2File);
  278.   IOCheck;
  279.   FileName := Concat(Command_Line_Path, 'INDIV2.DAT');
  280.   Assign(Indiv2File,FileName);
  281.   Reset(Indiv2File);
  282.   IOCheck;
  283.   FileName := 'INDIV2.TXT';
  284.   Assign(Indiv2Txt,FileName);
  285.   Rewrite(Indiv2Txt);
  286.   IOCheck;
  287. end; {procedure Open_Files}
  288.  
  289. procedure Close_Files;
  290. Begin
  291.   Close(Name2File);
  292.   IOCheck;
  293.   Close(Indiv2File);
  294.   IOCheck;
  295.   Close(Indiv2Txt);
  296.   IOCheck;
  297. end; {procedure Close_Files}
  298.  
  299.  
  300.  
  301. Begin
  302.   ClrScr;
  303.   WriteLn;
  304.   WriteLn('READPAF - an abbreviated version of FR2SDF');
  305.   WriteLn('to demonstrate how to read PAF files.');
  306.   WriteLn('Copyright (c) 1989 by Joseph R. Wood.');
  307.   WriteLn('Permission is granted to copy for');
  308.   WriteLn('noncommercial or nonprofit use only.');
  309.   WriteLn('All other rights reserved.');
  310.   WriteLn;
  311.   Open_Files;
  312.   Read(Indiv2File, ThisIndiv2); {Do a priming read and throw away}
  313.   IOCheck;                      {the file's header record}
  314.   With ThisIndiv2 Do
  315.   While not eof(Indiv2File)
  316.   DO Begin
  317.     Read(Indiv2File, ThisIndiv2);
  318.     IOCheck;
  319.     Convert_Indiv2;
  320.   End;
  321.   Close_Files;
  322.   WriteLn;
  323.   WriteLn('READPAF Terminated Normally.');
  324. End.
  325.  
  326.